home *** CD-ROM | disk | FTP | other *** search
/ PC World Interactive 7 / PC World Interactive 7.iso / share / multimed / myflix_win32 / data1.cab / Libraries / tk8.0 / Text.tcl < prev    next >
Encoding:
Text File  |  1998-03-10  |  25.5 KB  |  1,008 lines
  1. # text.tcl --
  2. #
  3. # This file defines the default bindings for Tk text widgets and provides
  4. # procedures that help in implementing the bindings.
  5. #
  6. # SCCS: @(#) text.tcl 1.55 97/08/12 14:28:23
  7. #
  8. # Copyright (c) 1992-1994 The Regents of the University of California.
  9. # Copyright (c) 1994-1996 Sun Microsystems, Inc.
  10. #
  11. # See the file "license.terms" for information on usage and redistribution
  12. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  13. #
  14.  
  15. #-------------------------------------------------------------------------
  16. # Elements of tkPriv that are used in this file:
  17. #
  18. # afterId -        If non-null, it means that auto-scanning is underway
  19. #            and it gives the "after" id for the next auto-scan
  20. #            command to be executed.
  21. # char -        Character position on the line;  kept in order
  22. #            to allow moving up or down past short lines while
  23. #            still remembering the desired position.
  24. # mouseMoved -        Non-zero means the mouse has moved a significant
  25. #            amount since the button went down (so, for example,
  26. #            start dragging out a selection).
  27. # prevPos -        Used when moving up or down lines via the keyboard.
  28. #            Keeps track of the previous insert position, so
  29. #            we can distinguish a series of ups and downs, all
  30. #            in a row, from a new up or down.
  31. # selectMode -        The style of selection currently underway:
  32. #            char, word, or line.
  33. # x, y -        Last known mouse coordinates for scanning
  34. #            and auto-scanning.
  35. #-------------------------------------------------------------------------
  36.  
  37. #-------------------------------------------------------------------------
  38. # The code below creates the default class bindings for entries.
  39. #-------------------------------------------------------------------------
  40.  
  41. # Standard Motif bindings:
  42.  
  43. bind Text <1> {
  44.     tkTextButton1 %W %x %y
  45.     %W tag remove sel 0.0 end
  46. }
  47. bind Text <B1-Motion> {
  48.     set tkPriv(x) %x
  49.     set tkPriv(y) %y
  50.     tkTextSelectTo %W %x %y
  51. }
  52. bind Text <Double-1> {
  53.     set tkPriv(selectMode) word
  54.     tkTextSelectTo %W %x %y
  55.     catch {%W mark set insert sel.first}
  56. }
  57. bind Text <Triple-1> {
  58.     set tkPriv(selectMode) line
  59.     tkTextSelectTo %W %x %y
  60.     catch {%W mark set insert sel.first}
  61. }
  62. bind Text <Shift-1> {
  63.     tkTextResetAnchor %W @%x,%y
  64.     set tkPriv(selectMode) char
  65.     tkTextSelectTo %W %x %y
  66. }
  67. bind Text <Double-Shift-1>    {
  68.     set tkPriv(selectMode) word
  69.     tkTextSelectTo %W %x %y
  70. }
  71. bind Text <Triple-Shift-1>    {
  72.     set tkPriv(selectMode) line
  73.     tkTextSelectTo %W %x %y
  74. }
  75. bind Text <B1-Leave> {
  76.     set tkPriv(x) %x
  77.     set tkPriv(y) %y
  78.     tkTextAutoScan %W
  79. }
  80. bind Text <B1-Enter> {
  81.     tkCancelRepeat
  82. }
  83. bind Text <ButtonRelease-1> {
  84.     tkCancelRepeat
  85. }
  86. bind Text <Control-1> {
  87.     %W mark set insert @%x,%y
  88. }
  89. bind Text <ButtonRelease-2> {
  90.     if {!$tkPriv(mouseMoved) || $tk_strictMotif} {
  91.     tkTextPaste %W %x %y
  92.     }
  93. }
  94. bind Text <Left> {
  95.     tkTextSetCursor %W insert-1c
  96. }
  97. bind Text <Right> {
  98.     tkTextSetCursor %W insert+1c
  99. }
  100. bind Text <Up> {
  101.     tkTextSetCursor %W [tkTextUpDownLine %W -1]
  102. }
  103. bind Text <Down> {
  104.     tkTextSetCursor %W [tkTextUpDownLine %W 1]
  105. }
  106. bind Text <Shift-Left> {
  107.     tkTextKeySelect %W [%W index {insert - 1c}]
  108. }
  109. bind Text <Shift-Right> {
  110.     tkTextKeySelect %W [%W index {insert + 1c}]
  111. }
  112. bind Text <Shift-Up> {
  113.     tkTextKeySelect %W [tkTextUpDownLine %W -1]
  114. }
  115. bind Text <Shift-Down> {
  116.     tkTextKeySelect %W [tkTextUpDownLine %W 1]
  117. }
  118. bind Text <Control-Left> {
  119.     tkTextSetCursor %W [tkTextPrevPos %W insert tcl_startOfPreviousWord]
  120. }
  121. bind Text <Control-Right> {
  122.     tkTextSetCursor %W [tkTextNextWord %W insert]
  123. }
  124. bind Text <Control-Up> {
  125.     tkTextSetCursor %W [tkTextPrevPara %W insert]
  126. }
  127. bind Text <Control-Down> {
  128.     tkTextSetCursor %W [tkTextNextPara %W insert]
  129. }
  130. bind Text <Shift-Control-Left> {
  131.     tkTextKeySelect %W [tkTextPrevPos %W insert tcl_startOfPreviousWord]
  132. }
  133. bind Text <Shift-Control-Right> {
  134.     tkTextKeySelect %W [tkTextNextWord %W insert]
  135. }
  136. bind Text <Shift-Control-Up> {
  137.     tkTextKeySelect %W [tkTextPrevPara %W insert]
  138. }
  139. bind Text <Shift-Control-Down> {
  140.     tkTextKeySelect %W [tkTextNextPara %W insert]
  141. }
  142. bind Text <Prior> {
  143.     tkTextSetCursor %W [tkTextScrollPages %W -1]
  144. }
  145. bind Text <Shift-Prior> {
  146.     tkTextKeySelect %W [tkTextScrollPages %W -1]
  147. }
  148. bind Text <Next> {
  149.     tkTextSetCursor %W [tkTextScrollPages %W 1]
  150. }
  151. bind Text <Shift-Next> {
  152.     tkTextKeySelect %W [tkTextScrollPages %W 1]
  153. }
  154. bind Text <Control-Prior> {
  155.     %W xview scroll -1 page
  156. }
  157. bind Text <Control-Next> {
  158.     %W xview scroll 1 page
  159. }
  160.  
  161. bind Text <Home> {
  162.     tkTextSetCursor %W {insert linestart}
  163. }
  164. bind Text <Shift-Home> {
  165.     tkTextKeySelect %W {insert linestart}
  166. }
  167. bind Text <End> {
  168.     tkTextSetCursor %W {insert lineend}
  169. }
  170. bind Text <Shift-End> {
  171.     tkTextKeySelect %W {insert lineend}
  172. }
  173. bind Text <Control-Home> {
  174.     tkTextSetCursor %W 1.0
  175. }
  176. bind Text <Control-Shift-Home> {
  177.     tkTextKeySelect %W 1.0
  178. }
  179. bind Text <Control-End> {
  180.     tkTextSetCursor %W {end - 1 char}
  181. }
  182. bind Text <Control-Shift-End> {
  183.     tkTextKeySelect %W {end - 1 char}
  184. }
  185.  
  186. bind Text <Tab> {
  187.     tkTextInsert %W \t
  188.     focus %W
  189.     break
  190. }
  191. bind Text <Shift-Tab> {
  192.     # Needed only to keep <Tab> binding from triggering;  doesn't
  193.     # have to actually do anything.
  194.     break
  195. }
  196. bind Text <Control-Tab> {
  197.     focus [tk_focusNext %W]
  198. }
  199. bind Text <Control-Shift-Tab> {
  200.     focus [tk_focusPrev %W]
  201. }
  202. bind Text <Control-i> {
  203.     tkTextInsert %W \t
  204. }
  205. bind Text <Return> {
  206.     tkTextInsert %W \n
  207. }
  208. bind Text <Delete> {
  209.     if {[%W tag nextrange sel 1.0 end] != ""} {
  210.     %W delete sel.first sel.last
  211.     } else {
  212.     %W delete insert
  213.     %W see insert
  214.     }
  215. }
  216. bind Text <BackSpace> {
  217.     if {[%W tag nextrange sel 1.0 end] != ""} {
  218.     %W delete sel.first sel.last
  219.     } elseif [%W compare insert != 1.0] {
  220.     %W delete insert-1c
  221.     %W see insert
  222.     }
  223. }
  224.  
  225. bind Text <Control-space> {
  226.     %W mark set anchor insert
  227. }
  228. bind Text <Select> {
  229.     %W mark set anchor insert
  230. }
  231. bind Text <Control-Shift-space> {
  232.     set tkPriv(selectMode) char
  233.     tkTextKeyExtend %W insert
  234. }
  235. bind Text <Shift-Select> {
  236.     set tkPriv(selectMode) char
  237.     tkTextKeyExtend %W insert
  238. }
  239. bind Text <Control-slash> {
  240.     %W tag add sel 1.0 end
  241. }
  242. bind Text <Control-backslash> {
  243.     %W tag remove sel 1.0 end
  244. }
  245. bind Text <<Cut>> {
  246.     tk_textCut %W
  247. }
  248. bind Text <<Copy>> {
  249.     tk_textCopy %W
  250. }
  251. bind Text <<Paste>> {
  252.     tk_textPaste %W
  253. }
  254. bind Text <<Clear>> {
  255.     catch {%W delete sel.first sel.last}
  256. }
  257. bind Text <Insert> {
  258.     catch {tkTextInsert %W [selection get -displayof %W]}
  259. }
  260. bind Text <KeyPress> {
  261.     tkTextInsert %W %A
  262. }
  263.  
  264. # Ignore all Alt, Meta, and Control keypresses unless explicitly bound.
  265. # Otherwise, if a widget binding for one of these is defined, the
  266. # <KeyPress> class binding will also fire and insert the character,
  267. # which is wrong.  Ditto for <Escape>.
  268.  
  269. bind Text <Alt-KeyPress> {# nothing }
  270. bind Text <Meta-KeyPress> {# nothing}
  271. bind Text <Control-KeyPress> {# nothing}
  272. bind Text <Escape> {# nothing}
  273. bind Text <KP_Enter> {# nothing}
  274.  
  275. # Additional emacs-like bindings:
  276.  
  277. bind Text <Control-a> {
  278.     if !$tk_strictMotif {
  279.     tkTextSetCursor %W {insert linestart}
  280.     }
  281. }
  282. bind Text <Control-b> {
  283.     if !$tk_strictMotif {
  284.     tkTextSetCursor %W insert-1c
  285.     }
  286. }
  287. bind Text <Control-d> {
  288.     if !$tk_strictMotif {
  289.     %W delete insert
  290.     }
  291. }
  292. bind Text <Control-e> {
  293.     if !$tk_strictMotif {
  294.     tkTextSetCursor %W {insert lineend}
  295.     }
  296. }
  297. bind Text <Control-f> {
  298.     if !$tk_strictMotif {
  299.     tkTextSetCursor %W insert+1c
  300.     }
  301. }
  302. bind Text <Control-k> {
  303.     if !$tk_strictMotif {
  304.     if [%W compare insert == {insert lineend}] {
  305.         %W delete insert
  306.     } else {
  307.         %W delete insert {insert lineend}
  308.     }
  309.     }
  310. }
  311. bind Text <Control-n> {
  312.     if !$tk_strictMotif {
  313.     tkTextSetCursor %W [tkTextUpDownLine %W 1]
  314.     }
  315. }
  316. bind Text <Control-o> {
  317.     if !$tk_strictMotif {
  318.     %W insert insert \n
  319.     %W mark set insert insert-1c
  320.     }
  321. }
  322. bind Text <Control-p> {
  323.     if !$tk_strictMotif {
  324.     tkTextSetCursor %W [tkTextUpDownLine %W -1]
  325.     }
  326. }
  327. bind Text <Control-t> {
  328.     if !$tk_strictMotif {
  329.     tkTextTranspose %W
  330.     }
  331. }
  332.  
  333. if {$tcl_platform(platform) != "windows"} {
  334. bind Text <Control-v> {
  335.     if !$tk_strictMotif {
  336.     tkTextScrollPages %W 1
  337.     }
  338. }
  339. }
  340.  
  341. bind Text <Meta-b> {
  342.     if !$tk_strictMotif {
  343.     tkTextSetCursor %W [tkTextPrevPos %W insert tcl_startOfPreviousWord]
  344.     }
  345. }
  346. bind Text <Meta-d> {
  347.     if !$tk_strictMotif {
  348.     %W delete insert [tkTextNextWord %W insert]
  349.     }
  350. }
  351. bind Text <Meta-f> {
  352.     if !$tk_strictMotif {
  353.     tkTextSetCursor %W [tkTextNextWord %W insert]
  354.     }
  355. }
  356. bind Text <Meta-less> {
  357.     if !$tk_strictMotif {
  358.     tkTextSetCursor %W 1.0
  359.     }
  360. }
  361. bind Text <Meta-greater> {
  362.     if !$tk_strictMotif {
  363.     tkTextSetCursor %W end-1c
  364.     }
  365. }
  366. bind Text <Meta-BackSpace> {
  367.     if !$tk_strictMotif {
  368.     %W delete [tkTextPrevPos %W insert tcl_startOfPreviousWord] insert
  369.     }
  370. }
  371. bind Text <Meta-Delete> {
  372.     if !$tk_strictMotif {
  373.     %W delete [tkTextPrevPos %W insert tcl_startOfPreviousWord] insert
  374.     }
  375. }
  376.  
  377. # Macintosh only bindings:
  378.  
  379. # if text black & highlight black -> text white, other text the same
  380. if {$tcl_platform(platform) == "macintosh"} {
  381. bind Text <FocusIn> {
  382.     %W tag configure sel -borderwidth 0
  383.     %W configure -selectbackground systemHighlight -selectforeground systemHighlightText
  384. }
  385. bind Text <FocusOut> {
  386.     %W tag configure sel -borderwidth 1
  387.     %W configure -selectbackground white -selectforeground black
  388. }
  389. bind Text <Option-Left> {
  390.     tkTextSetCursor %W [tkTextPrevPos %W insert tcl_startOfPreviousWord]
  391. }
  392. bind Text <Option-Right> {
  393.     tkTextSetCursor %W [tkTextNextWord %W insert]
  394. }
  395. bind Text <Option-Up> {
  396.     tkTextSetCursor %W [tkTextPrevPara %W insert]
  397. }
  398. bind Text <Option-Down> {
  399.     tkTextSetCursor %W [tkTextNextPara %W insert]
  400. }
  401. bind Text <Shift-Option-Left> {
  402.     tkTextKeySelect %W [tkTextPrevPos %W insert tcl_startOfPreviousWord]
  403. }
  404. bind Text <Shift-Option-Right> {
  405.     tkTextKeySelect %W [tkTextNextWord %W insert]
  406. }
  407. bind Text <Shift-Option-Up> {
  408.     tkTextKeySelect %W [tkTextPrevPara %W insert]
  409. }
  410. bind Text <Shift-Option-Down> {
  411.     tkTextKeySelect %W [tkTextNextPara %W insert]
  412. }
  413.  
  414. # End of Mac only bindings
  415. }
  416.  
  417. # A few additional bindings of my own.
  418.  
  419. bind Text <Control-h> {
  420.     if !$tk_strictMotif {
  421.     if [%W compare insert != 1.0] {
  422.         %W delete insert-1c
  423.         %W see insert
  424.     }
  425.     }
  426. }
  427. bind Text <2> {
  428.     if !$tk_strictMotif {
  429.     %W scan mark %x %y
  430.     set tkPriv(x) %x
  431.     set tkPriv(y) %y
  432.     set tkPriv(mouseMoved) 0
  433.     }
  434. }
  435. bind Text <B2-Motion> {
  436.     if !$tk_strictMotif {
  437.     if {(%x != $tkPriv(x)) || (%y != $tkPriv(y))} {
  438.         set tkPriv(mouseMoved) 1
  439.     }
  440.     if $tkPriv(mouseMoved) {
  441.         %W scan dragto %x %y
  442.     }
  443.     }
  444. }
  445. set tkPriv(prevPos) {}
  446.  
  447. # tkTextClosestGap --
  448. # Given x and y coordinates, this procedure finds the closest boundary
  449. # between characters to the given coordinates and returns the index
  450. # of the character just after the boundary.
  451. #
  452. # Arguments:
  453. # w -        The text window.
  454. # x -        X-coordinate within the window.
  455. # y -        Y-coordinate within the window.
  456.  
  457. proc tkTextClosestGap {w x y} {
  458.     set pos [$w index @$x,$y]
  459.     set bbox [$w bbox $pos]
  460.     if ![string compare $bbox ""] {
  461.     return $pos
  462.     }
  463.     if {($x - [lindex $bbox 0]) < ([lindex $bbox 2]/2)} {
  464.     return $pos
  465.     }
  466.     $w index "$pos + 1 char"
  467. }
  468.  
  469. # tkTextButton1 --
  470. # This procedure is invoked to handle button-1 presses in text
  471. # widgets.  It moves the insertion cursor, sets the selection anchor,
  472. # and claims the input focus.
  473. #
  474. # Arguments:
  475. # w -        The text window in which the button was pressed.
  476. # x -        The x-coordinate of the button press.
  477. # y -        The x-coordinate of the button press.
  478.  
  479. proc tkTextButton1 {w x y} {
  480.     global tkPriv
  481.  
  482.     set tkPriv(selectMode) char
  483.     set tkPriv(mouseMoved) 0
  484.     set tkPriv(pressX) $x
  485.     $w mark set insert [tkTextClosestGap $w $x $y]
  486.     $w mark set anchor insert
  487.     if {[$w cget -state] == "normal"} {focus $w}
  488. }
  489.  
  490. # tkTextSelectTo --
  491. # This procedure is invoked to extend the selection, typically when
  492. # dragging it with the mouse.  Depending on the selection mode (character,
  493. # word, line) it selects in different-sized units.  This procedure
  494. # ignores mouse motions initially until the mouse has moved from
  495. # one character to another or until there have been multiple clicks.
  496. #
  497. # Arguments:
  498. # w -        The text window in which the button was pressed.
  499. # x -        Mouse x position.
  500. # y -         Mouse y position.
  501.  
  502. proc tkTextSelectTo {w x y} {
  503.     global tkPriv tcl_platform
  504.  
  505.     set cur [tkTextClosestGap $w $x $y]
  506.     if [catch {$w index anchor}] {
  507.     $w mark set anchor $cur
  508.     }
  509.     set anchor [$w index anchor]
  510.     if {[$w compare $cur != $anchor] || (abs($tkPriv(pressX) - $x) >= 3)} {
  511.     set tkPriv(mouseMoved) 1
  512.     }
  513.     switch $tkPriv(selectMode) {
  514.     char {
  515.         if [$w compare $cur < anchor] {
  516.         set first $cur
  517.         set last anchor
  518.         } else {
  519.         set first anchor
  520.         set last $cur
  521.         }
  522.     }
  523.     word {
  524.         if [$w compare $cur < anchor] {
  525.         set first [tkTextPrevPos $w "$cur + 1c" tcl_wordBreakBefore]
  526.         set last [tkTextNextPos $w "anchor" tcl_wordBreakAfter]
  527.         } else {
  528.         set first [tkTextPrevPos $w anchor tcl_wordBreakBefore]
  529.         set last [tkTextNextPos $w "$cur - 1c" tcl_wordBreakAfter]
  530.         }
  531.     }
  532.     line {
  533.         if [$w compare $cur < anchor] {
  534.         set first [$w index "$cur linestart"]
  535.         set last [$w index "anchor - 1c lineend + 1c"]
  536.         } else {
  537.         set first [$w index "anchor linestart"]
  538.         set last [$w index "$cur lineend + 1c"]
  539.         }
  540.     }
  541.     }
  542.     if {$tkPriv(mouseMoved) || ($tkPriv(selectMode) != "char")} {
  543.     if {$tcl_platform(platform) != "unix" && [$w compare $cur < anchor]} {
  544.         $w mark set insert $first
  545.     } else {
  546.         $w mark set insert $last
  547.     }
  548.     $w tag remove sel 0.0 $first
  549.     $w tag add sel $first $last
  550.     $w tag remove sel $last end
  551.     update idletasks
  552.     }
  553. }
  554.  
  555. # tkTextKeyExtend --
  556. # This procedure handles extending the selection from the keyboard,
  557. # where the point to extend to is really the boundary between two
  558. # characters rather than a particular character.
  559. #
  560. # Arguments:
  561. # w -        The text window.
  562. # index -    The point to which the selection is to be extended.
  563.  
  564. proc tkTextKeyExtend {w index} {
  565.     global tkPriv
  566.  
  567.     set cur [$w index $index]
  568.     if [catch {$w index anchor}] {
  569.     $w mark set anchor $cur
  570.     }
  571.     set anchor [$w index anchor]
  572.     if [$w compare $cur < anchor] {
  573.     set first $cur
  574.     set last anchor
  575.     } else {
  576.     set first anchor
  577.     set last $cur
  578.     }
  579.     $w tag remove sel 0.0 $first
  580.     $w tag add sel $first $last
  581.     $w tag remove sel $last end
  582. }
  583.  
  584. # tkTextPaste --
  585. # This procedure sets the insertion cursor to the mouse position,
  586. # inserts the selection, and sets the focus to the window.
  587. #
  588. # Arguments:
  589. # w -        The text window.
  590. # x, y -     Position of the mouse.
  591.  
  592. proc tkTextPaste {w x y} {
  593.     $w mark set insert [tkTextClosestGap $w $x $y]
  594.     catch {$w insert insert [selection get -displayof $w]}
  595.     if {[$w cget -state] == "normal"} {focus $w}
  596. }
  597.  
  598. # tkTextAutoScan --
  599. # This procedure is invoked when the mouse leaves a text window
  600. # with button 1 down.  It scrolls the window up, down, left, or right,
  601. # depending on where the mouse is (this information was saved in
  602. # tkPriv(x) and tkPriv(y)), and reschedules itself as an "after"
  603. # command so that the window continues to scroll until the mouse
  604. # moves back into the window or the mouse button is released.
  605. #
  606. # Arguments:
  607. # w -        The text window.
  608.  
  609. proc tkTextAutoScan {w} {
  610.     global tkPriv
  611.     if {![winfo exists $w]} return
  612.     if {$tkPriv(y) >= [winfo height $w]} {
  613.     $w yview scroll 2 units
  614.     } elseif {$tkPriv(y) < 0} {
  615.     $w yview scroll -2 units
  616.     } elseif {$tkPriv(x) >= [winfo width $w]} {
  617.     $w xview scroll 2 units
  618.     } elseif {$tkPriv(x) < 0} {
  619.     $w xview scroll -2 units
  620.     } else {
  621.     return
  622.     }
  623.     tkTextSelectTo $w $tkPriv(x) $tkPriv(y)
  624.     set tkPriv(afterId) [after 50 tkTextAutoScan $w]
  625. }
  626.  
  627. # tkTextSetCursor
  628. # Move the insertion cursor to a given position in a text.  Also
  629. # clears the selection, if there is one in the text, and makes sure
  630. # that the insertion cursor is visible.  Also, don't let the insertion
  631. # cursor appear on the dummy last line of the text.
  632. #
  633. # Arguments:
  634. # w -        The text window.
  635. # pos -        The desired new position for the cursor in the window.
  636.  
  637. proc tkTextSetCursor {w pos} {
  638.     global tkPriv
  639.  
  640.     if [$w compare $pos == end] {
  641.     set pos {end - 1 chars}
  642.     }
  643.     $w mark set insert $pos
  644.     $w tag remove sel 1.0 end
  645.     $w see insert
  646. }
  647.  
  648. # tkTextKeySelect
  649. # This procedure is invoked when stroking out selections using the
  650. # keyboard.  It moves the cursor to a new position, then extends
  651. # the selection to that position.
  652. #
  653. # Arguments:
  654. # w -        The text window.
  655. # new -        A new position for the insertion cursor (the cursor hasn't
  656. #        actually been moved to this position yet).
  657.  
  658. proc tkTextKeySelect {w new} {
  659.     global tkPriv
  660.  
  661.     if {[$w tag nextrange sel 1.0 end] == ""} {
  662.     if [$w compare $new < insert] {
  663.         $w tag add sel $new insert
  664.     } else {
  665.         $w tag add sel insert $new
  666.     }
  667.     $w mark set anchor insert
  668.     } else {
  669.     if [$w compare $new < anchor] {
  670.         set first $new
  671.         set last anchor
  672.     } else {
  673.         set first anchor
  674.         set last $new
  675.     }
  676.     $w tag remove sel 1.0 $first
  677.     $w tag add sel $first $last
  678.     $w tag remove sel $last end
  679.     }
  680.     $w mark set insert $new
  681.     $w see insert
  682.     update idletasks
  683. }
  684.  
  685. # tkTextResetAnchor --
  686. # Set the selection anchor to whichever end is farthest from the
  687. # index argument.  One special trick: if the selection has two or
  688. # fewer characters, just leave the anchor where it is.  In this
  689. # case it doesn't matter which point gets chosen for the anchor,
  690. # and for the things like Shift-Left and Shift-Right this produces
  691. # better behavior when the cursor moves back and forth across the
  692. # anchor.
  693. #
  694. # Arguments:
  695. # w -        The text widget.
  696. # index -    Position at which mouse button was pressed, which determines
  697. #        which end of selection should be used as anchor point.
  698.  
  699. proc tkTextResetAnchor {w index} {
  700.     global tkPriv
  701.  
  702.     if {[$w tag ranges sel] == ""} {
  703.     $w mark set anchor $index
  704.     return
  705.     }
  706.     set a [$w index $index]
  707.     set b [$w index sel.first]
  708.     set c [$w index sel.last]
  709.     if [$w compare $a < $b] {
  710.     $w mark set anchor sel.last
  711.     return
  712.     }
  713.     if [$w compare $a > $c] {
  714.     $w mark set anchor sel.first
  715.     return
  716.     }
  717.     scan $a "%d.%d" lineA chA
  718.     scan $b "%d.%d" lineB chB
  719.     scan $c "%d.%d" lineC chC
  720.     if {$lineB < $lineC+2} {
  721.     set total [string length [$w get $b $c]]
  722.     if {$total <= 2} {
  723.         return
  724.     }
  725.     if {[string length [$w get $b $a]] < ($total/2)} {
  726.         $w mark set anchor sel.last
  727.     } else {
  728.         $w mark set anchor sel.first
  729.     }
  730.     return
  731.     }
  732.     if {($lineA-$lineB) < ($lineC-$lineA)} {
  733.     $w mark set anchor sel.last
  734.     } else {
  735.     $w mark set anchor sel.first
  736.     }
  737. }
  738.  
  739. # tkTextInsert --
  740. # Insert a string into a text at the point of the insertion cursor.
  741. # If there is a selection in the text, and it covers the point of the
  742. # insertion cursor, then delete the selection before inserting.
  743. #
  744. # Arguments:
  745. # w -        The text window in which to insert the string
  746. # s -        The string to insert (usually just a single character)
  747.  
  748. proc tkTextInsert {w s} {
  749.     if {($s == "") || ([$w cget -state] == "disabled")} {
  750.     return
  751.     }
  752.     catch {
  753.     if {[$w compare sel.first <= insert]
  754.         && [$w compare sel.last >= insert]} {
  755.         $w delete sel.first sel.last
  756.     }
  757.     }
  758.     $w insert insert $s
  759.     $w see insert
  760. }
  761.  
  762. # tkTextUpDownLine --
  763. # Returns the index of the character one line above or below the
  764. # insertion cursor.  There are two tricky things here.  First,
  765. # we want to maintain the original column across repeated operations,
  766. # even though some lines that will get passed through don't have
  767. # enough characters to cover the original column.  Second, don't
  768. # try to scroll past the beginning or end of the text.
  769. #
  770. # Arguments:
  771. # w -        The text window in which the cursor is to move.
  772. # n -        The number of lines to move: -1 for up one line,
  773. #        +1 for down one line.
  774.  
  775. proc tkTextUpDownLine {w n} {
  776.     global tkPriv
  777.  
  778.     set i [$w index insert]
  779.     scan $i "%d.%d" line char
  780.     if {[string compare $tkPriv(prevPos) $i] != 0} {
  781.     set tkPriv(char) $char
  782.     }
  783.     set new [$w index [expr $line + $n].$tkPriv(char)]
  784.     if {[$w compare $new == end] || [$w compare $new == "insert linestart"]} {
  785.     set new $i
  786.     }
  787.     set tkPriv(prevPos) $new
  788.     return $new
  789. }
  790.  
  791. # tkTextPrevPara --
  792. # Returns the index of the beginning of the paragraph just before a given
  793. # position in the text (the beginning of a paragraph is the first non-blank
  794. # character after a blank line).
  795. #
  796. # Arguments:
  797. # w -        The text window in which the cursor is to move.
  798. # pos -        Position at which to start search.
  799.  
  800. proc tkTextPrevPara {w pos} {
  801.     set pos [$w index "$pos linestart"]
  802.     while 1 {
  803.     if {(([$w get "$pos - 1 line"] == "\n") && ([$w get $pos] != "\n"))
  804.         || ($pos == "1.0")} {
  805.         if [regexp -indices {^[     ]+(.)} [$w get $pos "$pos lineend"] \
  806.             dummy index] {
  807.         set pos [$w index "$pos + [lindex $index 0] chars"]
  808.         }
  809.         if {[$w compare $pos != insert] || ($pos == "1.0")} {
  810.         return $pos
  811.         }
  812.     }
  813.     set pos [$w index "$pos - 1 line"]
  814.     }
  815. }
  816.  
  817. # tkTextNextPara --
  818. # Returns the index of the beginning of the paragraph just after a given
  819. # position in the text (the beginning of a paragraph is the first non-blank
  820. # character after a blank line).
  821. #
  822. # Arguments:
  823. # w -        The text window in which the cursor is to move.
  824. # start -    Position at which to start search.
  825.  
  826. proc tkTextNextPara {w start} {
  827.     set pos [$w index "$start linestart + 1 line"]
  828.     while {[$w get $pos] != "\n"} {
  829.     if [$w compare $pos == end] {
  830.         return [$w index "end - 1c"]
  831.     }
  832.     set pos [$w index "$pos + 1 line"]
  833.     }
  834.     while {[$w get $pos] == "\n"} {
  835.     set pos [$w index "$pos + 1 line"]
  836.     if [$w compare $pos == end] {
  837.         return [$w index "end - 1c"]
  838.     }
  839.     }
  840.     if [regexp -indices {^[     ]+(.)} [$w get $pos "$pos lineend"] \
  841.         dummy index] {
  842.     return [$w index "$pos + [lindex $index 0] chars"]
  843.     }
  844.     return $pos
  845. }
  846.  
  847. # tkTextScrollPages --
  848. # This is a utility procedure used in bindings for moving up and down
  849. # pages and possibly extending the selection along the way.  It scrolls
  850. # the view in the widget by the number of pages, and it returns the
  851. # index of the character that is at the same position in the new view
  852. # as the insertion cursor used to be in the old view.
  853. #
  854. # Arguments:
  855. # w -        The text window in which the cursor is to move.
  856. # count -    Number of pages forward to scroll;  may be negative
  857. #        to scroll backwards.
  858.  
  859. proc tkTextScrollPages {w count} {
  860.     set bbox [$w bbox insert]
  861.     $w yview scroll $count pages
  862.     if {$bbox == ""} {
  863.     return [$w index @[expr [winfo height $w]/2],0]
  864.     }
  865.     return [$w index @[lindex $bbox 0],[lindex $bbox 1]]
  866. }
  867.  
  868. # tkTextTranspose --
  869. # This procedure implements the "transpose" function for text widgets.
  870. # It tranposes the characters on either side of the insertion cursor,
  871. # unless the cursor is at the end of the line.  In this case it
  872. # transposes the two characters to the left of the cursor.  In either
  873. # case, the cursor ends up to the right of the transposed characters.
  874. #
  875. # Arguments:
  876. # w -        Text window in which to transpose.
  877.  
  878. proc tkTextTranspose w {
  879.     set pos insert
  880.     if [$w compare $pos != "$pos lineend"] {
  881.     set pos [$w index "$pos + 1 char"]
  882.     }
  883.     set new [$w get "$pos - 1 char"][$w get  "$pos - 2 char"]
  884.     if [$w compare "$pos - 1 char" == 1.0] {
  885.     return
  886.     }
  887.     $w delete "$pos - 2 char" $pos
  888.     $w insert insert $new
  889.     $w see insert
  890. }
  891.  
  892. # tk_textCopy --
  893. # This procedure copies the selection from a text widget into the
  894. # clipboard.
  895. #
  896. # Arguments:
  897. # w -        Name of a text widget.
  898.  
  899. proc tk_textCopy w {
  900.     clipboard clear -displayof $w
  901.     catch {
  902.     clipboard append -displayof $w [$w get sel.first sel.last]
  903.     }
  904. }
  905.  
  906. # tk_textCut --
  907. # This procedure copies the selection from a text widget into the
  908. # clipboard, then deletes the selection (if it exists in the given
  909. # widget).
  910. #
  911. # Arguments:
  912. # w -        Name of a text widget.
  913.  
  914. proc tk_textCut w {
  915.     clipboard clear -displayof $w
  916.     catch {
  917.     clipboard append -displayof $w [$w get sel.first sel.last]
  918.     $w delete sel.first sel.last
  919.     }
  920. }
  921.  
  922. # tk_textPaste --
  923. # This procedure pastes the contents of the clipboard to the insertion
  924. # point in a text widget.
  925. #
  926. # Arguments:
  927. # w -        Name of a text widget.
  928.  
  929. proc tk_textPaste w {
  930.     global tcl_platform
  931.     catch {
  932.     if {"$tcl_platform(platform)" != "unix"} {
  933.         catch {
  934.         $w delete sel.first sel.last
  935.         }
  936.     }
  937.     $w insert insert [selection get -displayof $w -selection CLIPBOARD]
  938.     }
  939. }
  940.  
  941. # tkTextNextWord --
  942. # Returns the index of the next word position after a given position in the
  943. # text.  The next word is platform dependent and may be either the next
  944. # end-of-word position or the next start-of-word position after the next
  945. # end-of-word position.
  946. #
  947. # Arguments:
  948. # w -        The text window in which the cursor is to move.
  949. # start -    Position at which to start search.
  950.  
  951. if {$tcl_platform(platform) == "windows"}  {
  952.     proc tkTextNextWord {w start} {
  953.     tkTextNextPos $w [tkTextNextPos $w $start tcl_endOfWord] \
  954.         tcl_startOfNextWord
  955.     }
  956. } else {
  957.     proc tkTextNextWord {w start} {
  958.     tkTextNextPos $w $start tcl_endOfWord
  959.     }
  960. }
  961.  
  962. # tkTextNextPos --
  963. # Returns the index of the next position after the given starting
  964. # position in the text as computed by a specified function.
  965. #
  966. # Arguments:
  967. # w -        The text window in which the cursor is to move.
  968. # start -    Position at which to start search.
  969. # op -        Function to use to find next position.
  970.  
  971. proc tkTextNextPos {w start op} {
  972.     set text ""
  973.     set cur $start
  974.     while {[$w compare $cur < end]} {
  975.     set text "$text[$w get $cur "$cur lineend + 1c"]"
  976.     set pos [$op $text 0]
  977.     if {$pos >= 0} {
  978.         return [$w index "$start + $pos c"]
  979.     }
  980.     set cur [$w index "$cur lineend +1c"]
  981.     }
  982.     return end
  983. }
  984.  
  985. # tkTextPrevPos --
  986. # Returns the index of the previous position before the given starting
  987. # position in the text as computed by a specified function.
  988. #
  989. # Arguments:
  990. # w -        The text window in which the cursor is to move.
  991. # start -    Position at which to start search.
  992. # op -        Function to use to find next position.
  993.  
  994. proc tkTextPrevPos {w start op} {
  995.     set text ""
  996.     set cur $start
  997.     while {[$w compare $cur > 0.0]} {
  998.     set text "[$w get "$cur linestart - 1c" $cur]$text"
  999.     set pos [$op $text end]
  1000.     if {$pos >= 0} {
  1001.         return [$w index "$cur linestart - 1c + $pos c"]
  1002.     }
  1003.     set cur [$w index "$cur linestart - 1c"]
  1004.     }
  1005.     return 0.0
  1006. }
  1007.  
  1008.